home *** CD-ROM | disk | FTP | other *** search
/ Shareware Extravaganza - Disc 4 / Shareware Extravaganza - Over 25,000 Programs (The Ultimate Shareware Company)(Disc 4 of 4)(1993).iso / cad / quikcmd2.zip / BOOM.LSP < prev    next >
Text File  |  1990-10-23  |  6KB  |  170 lines
  1. ;  BOOM.LSP
  2. ;
  3. ;                         QUICK COMMAND version 2.0
  4. ;                   BOOM.LSP is a module of QUICK COMMAND
  5. ;                        Copyright 1989, 1990 Dan Jincks
  6. ;
  7. ;
  8. ;              This is SHAREWARE, it is NOT Public Domain software.
  9. ;
  10. ;              This code or any part of this code may not be reproduced
  11. ;              in any publication without prior written permission.
  12. ;
  13. ;              Printed copy of this code or any part of this code may not
  14. ;              be distributed without prior written permission.
  15. ;
  16. ;              Printed copy may only be made for reference purposes by
  17. ;              the end user.
  18. ;
  19. ;
  20. ;                               Dan Jincks
  21. ;                             Box 155A HCR 77
  22. ;                           Annapolis, MO 63620
  23. ;
  24. ;
  25. ;
  26. ;   You are granted a limited license to use BOOM.LSP for a 30 day trial
  27. ;   period.  If you wish to continue using any or all of QUICK COMMAND after
  28. ;   the trial period, you must become a registered user.  As a registered
  29. ;   user, you may use QUICK COMMAND on 1 workstation or terminal.
  30. ;   Additional registrations must be bought for each additional workstation or
  31. ;   terminal.  To become a registered user, fill out the order form that can
  32. ;   be printed out from ORDERQC.DOC .
  33. ;
  34. ;
  35. ;   You may send copies of QUICK COMMAND to friends and associates if you abide
  36. ;   by the following rules:
  37. ;
  38. ;   1. It may only be distributed in the original unmodified form.
  39. ;   2. All original files must be included.
  40. ;   3. No addition files may be added.
  41. ;   4. If other files will be on the same disk, QUICK COMMAND files must be in
  42. ;      a library format such as ".ARC" called "QUICKCMD", or else be put alone
  43. ;      in a subdirectory called "QUICKCMD".
  44. ;   5. You may not sell QUICK COMMAND or any part of it.
  45. ;   6. You are not allowed to charge more then $5 to cover the cost of copying
  46. ;      and distribution.
  47. ;   7. You may not distribute any hard copy of the contents of QUICK COMMAND.
  48. ;
  49. ;
  50. ;   These AutoLISP commands and functions are designed to save you time, and
  51. ;   saving time means saving money.  The registration fee is very modest
  52. ;   compared to the savings, and much less expensive then typical third party
  53. ;   AutoCAD software. Be sure to registar if you continue to use them.
  54. ;
  55. ;
  56. ;                                                               DAN
  57. ;
  58. ;
  59. ;
  60. ;
  61. ;        AutoCAD and AutoLISP are registered trade marks of Autodesk Inc.
  62. ;
  63. ;        ***************************************************************
  64. ;
  65. ;   Begin BOOM.LSP
  66. ;
  67. (defun C:BOOM (/ SCA SCB SCC SCD SCE SCF SCH SCI SCJ SCN SCX SCY SCZ SSA SSB
  68.                  SCK SCG SCK SSC SSD SC1 SC2 SCBX SCPX SCMX SCDX)(TERPRI)
  69.    (prompt " Explode Blocks, Plines, 3D Meshes, Dimensions within a window.")
  70.    (terpri)
  71.    (prompt " An UNDO MARK has been placed")
  72.    (terpri)
  73.    (setvar "cmdecho" 0)
  74.    (command "UNDO" "MARK")
  75.    (setq SC1 (getpoint "First corner of window"))(terpri)
  76.    (setq SC2 (getcorner SC1 "Second corner"))(terpri)
  77.    (setq SCBX nil SCPX nil SCMX nil SCDX nil SCN nil SCF 0 SCI 0 SCH 0 SCG 0)
  78.    (setq SSB (ssadd))(setq SSD (ssadd))
  79.    (initget "Yes No")
  80.    (setq SCBX (getkword "Explode Blocks? Y/N <Yes> "))(terpri)
  81.    (initget "Yes No")
  82.    (setq SCPX (getkword "Explode Polylines Y/N <Yes> "))(terpri)
  83.    (initget "Yes No")
  84.    (setq SCMX (getkword "Explode 3D Meshes? Y/N <Yes> "))(terpri)
  85.    (initget "Yes No")
  86.    (setq SCDX (getkword "Explode Dimensions? Y/N <Yes> "))(terpri)
  87.    (if (/= SCBX "No")(progn
  88.       (initget "Yes No")
  89.       (setq SCN (getkword "Explode nested blocks? Y/N <Yes> "))(terpri)
  90.       (if (/= SCN "No")(setq SCK 2)(setq SCK 1))
  91.       (grclear)
  92.       (prompt " Exploding blocks. ")(terpri)
  93.        (while (/= SCG SCK)
  94.          (setq SSA (ssget "W" SC1 SC2))
  95.          (setq SCA 0)
  96.          (setq SCE (ssname SSA SCA))
  97.          (while (/= SCE nil)
  98.             (setq SCB (entget SCE))
  99.             (setq SCD (cdr (assoc 0 SCB)))
  100.             (setq SCX (cdr (assoc 41 SCB)))
  101.             (setq SCY (cdr (assoc 42 SCB)))
  102.             (setq SCZ (cdr (assoc 43 SCB)))
  103.             (if (= SCD "INSERT")(progn
  104.                (if (= SCX SCY SCZ)
  105.                (progn
  106.                   (command "EXPLODE" SCE)
  107.                      (if (/= SCN "No")(progn
  108.                        (setq SCC (entlast))
  109.                        (ssadd SCC SSA)
  110.                      ))
  111.                )
  112.                (progn
  113.                   (ssadd SCE SSB)
  114.                   (if (= SCK 1)(setq SCI (1+ SCI))(setq SCI (+ 0.5 SCI)))
  115.                )
  116.                )
  117.             ))
  118.             (setq SCA (1+ SCA))
  119.             (setq SCE (ssname SSA SCA))
  120.          )
  121.        (setq SCG (1+ SCG))
  122.        )
  123.       )(grclear)
  124.    )
  125.    (if (or (/= SCPX "No")(/= SCDX "No")(/= SCMX "No"))(progn
  126.       (setq SSC (ssget "W" SC1 SC2))
  127.       (setq SCA 0)
  128.       (setq SCE (ssname SSC SCA))
  129.       (prompt " Exploding --   ")
  130.       (if (/= SCPX "No")(prompt "Plines   "))
  131.       (if (/= SCDX "No")(prompt "Dimensions   "))
  132.       (if (/= SCMX "No")(prompt "3D Meshes   "))
  133.       (terpri)
  134.       (while (/= SCE nil)
  135.          (setq SCB (entget SCE))
  136.          (setq SCD (cdr (assoc 0 SCB)))
  137.          (setq SCJ (cdr (assoc 71 SCB)))
  138.          (if (= SCD "INSERT")(progn
  139.              (setq SCH 1)
  140.              (ssadd SCE SSD)
  141.          ))
  142.          (if (or (and (= SCJ 0)(/= SCPX "No")(= SCD "POLYLINE"))
  143.                  (and (/= SCDX "No")(= SCD "DIMENSION"))
  144.                  (and (> SCJ 0)(/= SCMX "No")(= SCD "POLYLINE")))
  145.             (command "EXPLODE" SCE)
  146.          )
  147.          (setq SCA (1+ SCA))
  148.          (setq SCE (ssname SSC SCA))
  149.       )
  150.    ))
  151.    (setq SCI (fix SCI))
  152.    (if (/= SCI 0)(progn (princ SCI)
  153.       (prompt "  BLOCKS WITH UNEQUAL X Y Z SCALE COULD NOT BE EXPLODED")(terpri)
  154.       (prompt "  Rejected Blocks are highlighted. PRESS ENTER ")(terpri)
  155.       (command "SELECT" SSB pause)
  156.    ))
  157.    (prompt "Area has been Exploded.")
  158.    (if (= SCH 1)(progn
  159.      (prompt "  Unexploded blocks are highlighted. PRESS ENTER.")
  160.      (command "SELECT" SSD pause)
  161.    ))
  162.    (terpri)
  163.    (prompt "Exploded objects are displayed.  PRESS ENTER    ")
  164.    (command "LIST" pause "REDRAW")
  165.    (prompt "Use UNDO BACK to restore drawing.")
  166.    (setvar "cmdecho" 1)(princ)
  167. )
  168. ;
  169. ;  End Boom
  170.